
with Ada.Text_Io,
Unchecked_Deallocation; 

use Ada.Text_Io;

package body Gestion_De_Textes is

   -- -----------------------------------------------------
   Trace : constant Boolean := False;
   -- -----------------------------------------------------

   procedure Free is new Unchecked_Deallocation
   ( Une_Chaine, Un_Texte );
                      

   -- ==========================
   -- Operations de consultation
   -- ========================== 
 
   -- -----------------------------------------------------

   function Valeur ( Le_Texte :    Texte ) 
      return        String is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** valeur");
      end if;
      return Le_Texte.T.Valeur;
   end Valeur;

   -- -----------------------------------------------------

   function Longueur ( Le_Texte: Texte ) 
      return    Natural is
                        
   begin
      -- trace
      if Trace then
         Put_Line("*** longueur");
      end if;
      return Le_Texte.T.Taille;    
   end Longueur;

   -- -----------------------------------------------------

   function Element  ( Le_Texte  :  Texte; 
         Au_Rang   :  Positive ) 
      return       Character is
             
   begin
      -- trace
      if Trace then
         Put_Line("*** element");
      end if;
      return Le_Texte.T.Valeur(Au_Rang);

   exception
      when Constraint_Error =>  -- AU_RANG est incorrect
         raise Erreur_Parametre_Incorrect;
   end Element;

   -- -----------------------------------------------------

   function Tranche  ( Le_Texte  :  Texte; 
         Du_Rang   :  Positive;
         Au_Rang   :  Positive ) 
      return       String is

   begin
      -- trace
      if Trace then
         Put_Line("*** tranche");
      end if;
      return Le_Texte.T.Valeur(Du_Rang..Au_Rang);

   exception
      when Constraint_Error =>    -- DU_RANG ou AU_RANG est incorrect
         raise Erreur_Parametre_Incorrect;
   end Tranche;

   -- -----------------------------------------------------

   function Sous_Texte ( Le_Texte :      Texte;
         Debut,
         Fin  :          Positive )
      return          Texte is
             
   begin
      -- trace
      if Trace then
         Put_Line("*** sous-texte");
      end if;
      return En_Texte(Le_Texte.T.Valeur(Debut..Fin));

   exception
      when Constraint_Error =>  
         raise Erreur_Parametre_Incorrect;
   end Sous_Texte;

   -- -----------------------------------------------------

   function Rang_De ( Le_Texte :   Texte;
         Dans :       Texte )
      return       Natural is
      Fin : Natural := Dans.T.Taille - Le_Texte.T.Taille+1;    
             
   begin
      -- trace
      if Trace then
         Put_Line("*** rang de");
      end if;
      for I in 1..Fin loop
         if Dans.T.Valeur(I .. I+Le_Texte.T.Taille-1) = Le_Texte.T.Valeur then
            return I;
         end if;
      end loop;
      return 0;
   end Rang_De;

   -- -----------------------------------------------------

   function Rang_De ( La_Chaine :  String;
         Dans :       Texte )
      return       Natural is
      Fin : Natural := Dans.T.Taille - La_Chaine'Length+1;    
             
   begin
      -- trace
      if Trace then
         Put_Line("*** rang de");
      end if;
 
      for I in 1..Fin loop
         if Dans.T.Valeur(I..I+La_Chaine'Length-1) = La_Chaine then
            return I;
         end if;
      end loop;
      return 0;
   end Rang_De;
  
   -- -----------------------------------------------------

   function Rang_De ( Le_Caractere :  Character;
         Dans :          Texte )
      return          Natural is
             
   begin
      -- trace
      if Trace then
         Put_Line("*** rang de");
      end if;
      for I in 1..Dans.T.Taille loop
         if Dans.T.Valeur(I) = Le_Caractere then
            return I;
         end if;
      end loop;
      return 0;
   end Rang_De;

   -- ========================
   -- Operations de conversion
   -- ======================== 

   -- -----------------------------------------------------

   function En_Texte ( La_Chaine : String ) 
      return      Texte is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** en texte");
      end if;
      return (Finalization.Controlled with (new Une_Chaine'(La_Chaine'Length, La_Chaine)));
   end En_Texte;

   -- -----------------------------------------------------

   function En_Texte ( Le_Caractere : Character ) 
      return         Texte is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** en texte");
      end if;
      return (Finalization.Controlled with (new Une_Chaine'(1, (1=>Le_Caractere))));
   end En_Texte;

   -- ===========================
   -- Operations de concatenation
   -- =========================== 

   -- -----------------------------------------------------

   function "&" (Op_G:  Texte; 
         Op_D:  Texte ) 
      return Texte is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** &");
      end if;
      return (Finalization.Controlled 
         with (new Une_Chaine'(Op_G.T.Taille + Op_D.T.Taille, Op_G.T.Valeur & Op_D.T.Valeur)));
   end "&";

   -- -----------------------------------------------------

   function "&" (Op_G:  Texte; 
         Op_D:  String ) 
      return Texte is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** &");
      end if;
      return (Finalization.Controlled 
         with (new Une_Chaine'(Op_G.T.Taille + Op_D'Length, Op_G.T.Valeur & Op_D)));
   end "&";

   -- -----------------------------------------------------

   function "&" (Op_G:  String; 
         Op_D:  Texte ) 
      return Texte is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** &");
      end if;
      return (Finalization.Controlled 
         with (new Une_Chaine'(Op_G'Length + Op_D.T.Taille, Op_G & Op_D.T.Valeur)));
   end "&";

   -- -----------------------------------------------------

   function "&" (Op_G:  Texte; 
         Op_D:  Character ) 
      return Texte is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** &");
      end if;
      return (Finalization.Controlled 
         with (new Une_Chaine'(Op_G.T.Taille + 1, Op_G.T.Valeur & Op_D)));
   end "&";

   -- -----------------------------------------------------

   function "&" (Op_G:  Character; 
         Op_D:  Texte ) 
      return Texte is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** &");
      end if;
      return (Finalization.Controlled 
         with (new Une_Chaine'(1 + Op_D.T.Taille, Op_G & Op_D.T.Valeur)));
   end "&";

   -- =========================
   -- Operations de comparaison
   -- ========================= 

   -- -----------------------------------------------------

   function "=" (Op_G: Texte; 
         Op_D: Texte) 
      return Boolean is
                
   begin
      -- trace
      if Trace then
         Put_Line("*** =");
      end if;
      return Op_G.T.Valeur = Op_D.T.Valeur;
   end "=";

   -- -----------------------------------------------------

   function "<" (Op_G:  Texte; 
         Op_D:  Texte) 
      return Boolean is
                
   begin
      -- trace
      if Trace then
         Put_Line("*** <");
      end if;
      return Op_G.T.Valeur < Op_D.T.Valeur;
   end "<";

   -- -----------------------------------------------------

   function "<=" (Op_G:  Texte; 
         Op_D:  Texte) 
      return Boolean is
                 
   begin
      -- trace
      if Trace then
         Put_Line("*** <=");
      end if;
      return Op_G.T.Valeur <= Op_D.T.Valeur;
   end "<=";

   -- -----------------------------------------------------

   function ">" (Op_G:  Texte; 
         Op_D:  Texte) 
      return Boolean is
                
   begin
      -- trace
      if Trace then
         Put_Line("*** >");
      end if;
      return Op_G.T.Valeur > Op_D.T.Valeur;
   end ">";

   -- -----------------------------------------------------

   function ">=" (Op_G:  Texte; 
         Op_D:  Texte) 
      return Boolean is
                 
   begin
      -- trace
      if Trace then
         Put_Line("*** >=");
      end if;
      return Op_G.T.Valeur >= Op_D.T.Valeur;
   end ">=";

   -- ======================
   -- Operations d'insertion
   -- ====================== 

   -- -----------------------------------------------------

   procedure Inserer ( Le_Texte:  in     Texte; 
         Dans:      in out Texte;
         Au_Rang:   in     Natural  :=1 ) is
      Tmp : Un_Texte;
    
   begin
      -- trace
      if Trace then
         Put_Line("*** inserer");
      end if;
      Tmp        := new Une_Chaine (Le_Texte.T.Taille + Dans.T.Taille);
      Tmp.Valeur := Dans.T.Valeur (1 .. Au_Rang-1)    &
      Le_Texte.T.Valeur            &
      Dans.T.Valeur (Au_Rang .. Dans.T.Taille);
      Free (Dans.T);
      Dans.T := Tmp;
    
   exception
      when Constraint_Error =>  
         raise Erreur_Parametre_Incorrect;
   end Inserer;
  
   -- -----------------------------------------------------

   procedure Inserer ( La_Chaine: in     String; 
         Dans:      in out Texte;
         Au_Rang:   in     Natural  :=1 ) is
      Tmp : Un_Texte;
    
   begin
      -- trace
      if Trace then
         Put_Line("*** inserer");
      end if;
      Tmp        := new Une_Chaine (La_Chaine'Length + Dans.T.Taille);
      Tmp.Valeur := Dans.T.Valeur (1 .. Au_Rang-1)    &
      La_Chaine          &
      Dans.T.Valeur (Au_Rang .. Dans.T.Taille);
      Free (Dans.T);
      Dans.T := Tmp;
    
   exception
      when Constraint_Error =>  
         raise Erreur_Parametre_Incorrect;
   end Inserer;
   -- -----------------------------------------------------

   procedure Inserer ( Le_Caractere: in     Character; 
         Dans:         in out Texte;
         Au_Rang:      in     Natural  :=1 ) is
      Tmp : Un_Texte;
    
   begin
      -- trace
      if Trace then
         Put_Line("*** inserer");
      end if;
      Tmp        := new Une_Chaine (1 + Dans.T.Taille);
      Tmp.Valeur := Dans.T.Valeur (1 .. Au_Rang-1)    &
      Le_Caractere               &
      Dans.T.Valeur (Au_Rang .. Dans.T.Taille);
      Free (Dans.T);
      Dans.T := Tmp;
    
   exception
      when Constraint_Error =>  
         raise Erreur_Parametre_Incorrect;
   end Inserer;

   -- ==============================
   -- Des operations de modification
   -- ==============================
                      
   procedure Modifier  ( Le_Texte        :  in out Texte; 
         Au_Rang         :  in     Positive;
         Par_Caractere   :  in     Character ) is

   begin
      -- trace
      if Trace then
         Put_Line("*** modifier");
      end if;
      Le_Texte.T.Valeur(Au_Rang) := Par_Caractere;
    
   exception
      when Constraint_Error =>  
         raise Erreur_Parametre_Incorrect;
   end Modifier;

   procedure Modifier  ( Le_Texte        :  in out Texte; 
         Du_Rang         :  in     Positive;                       
         Au_Rang         :  in     Positive;
         Par_Tranche     :  in     String ) is
   begin

      -- trace
      if Trace then
         Put_Line("*** modifier");
      end if;
      Le_Texte.T.Valeur(Du_Rang..Au_Rang) := Par_Tranche;
        
   exception
      when Constraint_Error =>  
         raise Erreur_Parametre_Incorrect;
   end Modifier;


   -- ===========================
   -- Operations du type controle
   -- =========================== 

   procedure Initialize (X : in out Texte) is
   begin
      X.T := new Une_Chaine (0);
   end Initialize;

   procedure Adjust     (X : in out Texte)is
   begin
      X.T := new Une_Chaine'(X.T.Taille, X.T.Valeur);
   end Adjust;

   procedure Finalize   (X : in out Texte) is
   begin
      Free(X.T);
   end Finalize;

   -- ======================
   -- Operation d'extraction
   -- ====================== 

   procedure Extraire   ( Depuis  :    in     Texte;
         Vers    :    in out Texte; 
         Du_Rang :    in     Natural;
         Au_Rang :    in     Natural ) is
    
   begin
      -- trace
      if Trace then
         Put_Line("*** extraire");
      end if;
      Free(Vers.T);
      Vers.T        := new Une_Chaine (Au_Rang - Du_Rang +1);
      Vers.T.Valeur := Depuis.T.Valeur(Du_Rang .. Au_Rang);
    
   exception
      when Constraint_Error =>
         raise Erreur_Parametre_Incorrect;
   end Extraire;

   -- ============================
   -- Operations d'entrees-sorties
   -- ============================ 

   -- -----------------------------------------------------

   procedure Put (Le_Texte:  in Texte;
         Format:    in Natural := 0) is
      use Text_Io;
    
   begin
      -- trace
      if Trace then
         Put_Line("*** put");
      end if;
      Put(Le_Texte.T.Valeur(1..Le_Texte.T.Taille));
      if Format-Le_Texte.T.Taille>0 then
         Set_Col(Col + Positive_Count(Format-Le_Texte.T.Taille));
      end if;
   end Put;

   -- -----------------------------------------------------

   procedure Get ( Le_Texte : in out Texte;
         Format   : in     Natural) is
      use Text_Io;
    
   begin
      -- trace
      if Trace then
         Put_Line("*** get");
      end if;
      Free (Le_Texte.T);
      Le_Texte.T := new Une_Chaine(Format);
      for I in 1..Format loop
         Get (Le_Texte.T.Valeur(I));
      end loop;
   end Get;
  
   -- -----------------------------------------------------
                  
   procedure Get_Line ( Le_Texte : in out Texte ) is
      Tampon : String (1..256);
      L      : Natural;
      use Text_Io;
    
   begin
      -- trace
      if Trace then
         Put_Line("*** get_line");
      end if;
      Free (Le_Texte.T);
      Get_Line (Tampon, L);
      Le_Texte.T        := new Une_Chaine(L);
      Le_Texte.T.Valeur := Tampon (1..L);
   end Get_Line;  

begin
   if Trace then
      Put_Line("Elaboration de gestion de textes");
   end if;
end Gestion_De_Textes;
